home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0195.ZIP / GETFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1984-12-03  |  6KB  |  163 lines
  1. {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
  2. The purchaser of these procedures and functions may include them in COMPILED
  3. programs freely, but may not sell or give away the source text.
  4.  
  5.      This program demonstrates the use of FIND_FIRST and FIND_NEXT, contained
  6.      in GETFILE.LIB.  You can enter a "template" (e.g., "*.COM", "BASIC*.*",
  7.      "FILE????.CHK") and a set of file attributes, and get back a list of
  8.      all the files matching the template and the attributes.
  9.  
  10.      "Ordinary" files will be found along with those with special attributes.
  11.      If you specify [E]xclusive, only those files with EXACTLY the attributes
  12.      you selected will be shown.  Thus, if your DOS disk is in drive A, you
  13.      might ask for "a:*.*" with attributes "RHS" and [E]xclusive, and you
  14.      would get the IBMBIOS.COM and IBMDOS.COM.
  15.  
  16.      For another use of GETFILE, see ALLFILES
  17.  
  18. }
  19. program get_file;
  20. {$I filename.typ}
  21. {$I regpack.typ}
  22. {$I getfile.lib}
  23. type
  24.   AttString = string[6];
  25.   CharSet   = set of char;
  26. const
  27.   AttChars : charset = ['R','H','S','V','D','A','Q'];
  28. var
  29.   att, choice : char;
  30.   row, N      : byte;
  31.   atts        : AttString;
  32.   okay        : boolean;
  33.   attribyte,
  34.   OldAttribute : byte;
  35. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  36. function convert(attribute:byte):AttString;
  37. var
  38.   temp : attString;
  39. begin
  40.   temp := '      ';
  41.   if attribute and 1 = 1 then temp[1] := 'R';
  42.   if attribute and 2 = 2 then temp[2] := 'H';
  43.   if attribute and 4 = 4 then temp[3] := 'S';
  44.   if attribute and 8 = 8 then temp[4] := 'V';
  45.   if attribute and 16 = 16 then temp[5] := 'D';
  46.   if attribute and 32 = 32 then temp[6] := 'A';
  47.   convert := temp;
  48. end;
  49. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  50. function UnConvert(atts : attString):byte;
  51. var
  52.   temp : byte;
  53. begin
  54.   temp := 0;
  55.   if pos('R',atts) <> 0 then temp := temp + 1;
  56.   if pos('H',atts) <> 0 then temp := temp + 2;
  57.   if pos('S',atts) <> 0 then temp := temp + 4;
  58.   if pos('V',atts) <> 0 then temp := temp + 8;
  59.   if pos('D',atts) <> 0 then temp := temp + 16;
  60.   if pos('A',atts) <> 0 then temp := temp + 32;
  61.   UnConvert := temp;
  62. end;
  63. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  64. begin
  65.     for row := 1 to 24 do
  66.       begin
  67.         gotoXY(40,row);
  68.         write('║');
  69.       end;
  70.     repeat
  71.       window(1,1,39,25);
  72.       ClrScr;
  73.       WriteLn('Enter the template for files sought.');
  74.       WriteLn('It can contain "wildcard" characters');
  75.       WriteLn('"*" and "?".');
  76.       ReadLn(filename);
  77.       WriteLn('Enter the attribute(s) to seek:');
  78.       WriteLn('[R]ead-only, [H]idden, [S]ystem, ');
  79.       WriteLn('[V]olume-label, [D]irectory, [A]rchive');
  80.       WriteLn('or [Q]uit.');
  81.       repeat
  82.         okay := true;                           {----------------------}
  83.         GotoXY(1,WhereY);                       { This segment just    }
  84.         read(atts);                             { makes sure that      }
  85.         for N := 1 to length(atts) do           { the input is legit.  }
  86.           begin                                 { If you use GETFILE   }
  87.             atts[N] := UpCase(atts[N]);         { in your own programs,}
  88.             if not (atts[N] in AttChars) then   { you will probably    }
  89.               okay := false;                    { enter the attribute  }
  90.           end;                                  { directly as a byte.  }
  91.       until okay;                               {----------------------}
  92.       attribyte := unConvert(atts);
  93.       if attribyte <> 0 then
  94.         begin
  95.           WriteLn; WriteLn;
  96.           WriteLn('[E]xclusive or [I]nclusive?');
  97.           WriteLn('(i.e., show ONLY files with');
  98.           WriteLn('exactly the specified attributes');
  99.           WriteLn('or all "normal" files plus those');
  100.           WriteLn('with the specified attributes).');
  101.           WriteLn('  NOTE: specify [E] if you just');
  102.           WriteLn('  want the [V]olume label.');
  103.           repeat
  104.             repeat until keypressed;
  105.             read(choice);
  106.             choice := UpCase(choice);
  107.             writeLn(choice);
  108.           until choice in ['E','I'];
  109.           window(41,1,80,25);
  110.           ClrScr;
  111.           OldAttribute := attribyte;
  112.  
  113. { Step one--Find the First file matching our criteria.}
  114.  
  115.           Find_First(attribyte,filename,error);
  116.           if error = 0 then
  117.             begin
  118.  
  119.               { If we asked for [E]xclusive choices, we want to
  120.               screen out any files that do not have exactly the
  121.               same attributes as our request.  However, we don't
  122.               care whether or not the ARCHIVE bit is set.  Thus
  123.               the condition "if attribyte MOD 32 = OldAttribute}
  124.  
  125.               if choice = 'E' then
  126.                 begin
  127.                   if attribyte mod 32 = OldAttribute then
  128.                      WriteLn(filename,'   ',convert(attribyte));
  129.                 end
  130.               else WriteLn(filename,'   ',convert(attribyte));
  131.  
  132.     {Now we repeat Find_Next until it DOESN't Find a Next--
  133.      that is, until error <> 0  }
  134.  
  135.               repeat
  136.                 Find_Next(attribyte,filename,error);
  137.                 if error = 0 then
  138.                   begin
  139.                     if choice = 'E' then
  140.                       begin
  141.                         if attribyte mod 32 = OldAttribute then
  142.                            WriteLn(filename,'   ',convert(attribyte));
  143.                       end
  144.                     else WriteLn(filename,'   ',convert(attribyte));
  145.                     if WhereY >= 24 then                {-----------------}
  146.                       begin                             { Stop when screen}
  147.                         WriteLn('Press a key...');      { gets full.      }
  148.                         repeat until keypressed;        {-----------------}
  149.                         ClrScr;
  150.                       end;
  151.                   end;
  152.                until error <> 0;
  153.                WriteLn('Press a key . . .');
  154.                repeat until keypressed;
  155.                ClrScr;
  156.             end;
  157.         end;
  158.     until attribyte = 0;
  159.     window(1,1,80,25);
  160. ClrScr;
  161. end.
  162.  
  163.